home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / program / misc / smalltlk.lha / Smalltalk3.09 / src / muiwin.st < prev    next >
Text File  |  1995-08-27  |  6KB  |  260 lines
  1. *
  2. * Little Smalltalk, version 3
  3. * Written by Tim Budd, Oregon State University, July 1988
  4. * Modified by David Faught, August 1995
  5. *
  6. *  Methods for the Amiga MUI front end.
  7. *  For now, much of the windowing stuff is rather staticly coded,
  8. *  instead of more general routines.
  9. *
  10. Class EventManager Process responses
  11. Class Window Object
  12. Class    BrowserWindow Window class method
  13. Methods Window 'all'
  14.     open
  15.         " open window number 1, the browser window "
  16.         <160 1>
  17. |    
  18.     close
  19.         " close window number 1"
  20.         <161 1>
  21. ]
  22. Methods EventManager 'all'
  23.     new
  24.         responses <- Array new: 14.
  25.         responses at: 1 put: [:w | ].
  26.         responses at: 2 put: [:w | browserWindow selClass: w ].
  27.         responses at: 3 put: [:w | browserWindow selMethod: w ].
  28.         responses at: 4 put: [:w | self command: w ].
  29.         responses at: 5 put: [:w | browserWindow open ].
  30.         responses at: 6 put: [:w | browserWindow editMethod ].
  31.         self moreNew.
  32. |
  33.     moreNew
  34.         responses at: 7 put: [:w | browserWindow fileIn ].
  35.         responses at: 8 put: [:w | browserWindow fileOut ].
  36.         responses at: 9 put: [:w | browserWindow saveImage ].
  37.         responses at: 10 put: [:w | browserWindow addClass ].
  38.         responses at: 11 put: [:w | browserWindow addMethod ].
  39.         responses at: 12 put: [:w | smalltalk echo ].
  40.         responses at: 13 put: [:w | smalltalk bytes ].
  41.         responses at: 14 put: [:w | browserWindow close ].
  42. |
  43.     execute    | event string |
  44.         " process one event "
  45.         event <- <170 (scheduler processCount)>.
  46.         string <- <171 event>.
  47.         string isNil
  48.             ifTrue: [ scheduler quit ]
  49.             ifFalse: [ ( (event >= 2) and: [(event <= 14)] )
  50.                 ifTrue: [ (responses at: event) value: string ]
  51.                 ]
  52. |
  53.     command: aString
  54.         " do a command "
  55.          (aString size > 0)
  56.             ifTrue: [ 
  57.                 echoInput ifTrue:
  58.                     [ aString print ].
  59.                 [ aString value print ] fork ] ]
  60. ]
  61. Methods BrowserWindow 'all'
  62.     open
  63.         super open.
  64.         self refreshClasses.
  65.         self selClass: 'Array'.
  66.         self selMethod: '<'
  67. |
  68.     refreshClasses
  69.         <180 1>.
  70.         classes do: [:a | <181 1 (a name)>].
  71. |
  72.     selClass: aString
  73.         class <- (aString asSymbol) value.
  74.         <182 1>.
  75.         class methods; do: [:a | <183 1 (a name)>].
  76. |
  77.     selMethod: aString
  78.         method <- class methodNamed: (aString asSymbol).
  79.         byteShow ifTrue: [ method showBytes ]
  80.             ifFalse: [ <185 1 (method text)> ].
  81. |
  82.     editMethod
  83.         class editMethod: (method name)
  84. |
  85.     fileOut
  86.         class fileOut
  87. |
  88.     addClass    | aString |
  89.         aString <- <204 'Enter superClass, nameOfClass & var1 ...'
  90.  'superClass addSubClass: #nameOfClass instanceVariableNames: ''var1 var2'' '>.
  91.         eventManager command: aString.
  92.         self refreshClasses.
  93. |
  94.     addMethod
  95.         class addMethod.
  96. |
  97.     fileIn
  98.         File new; fileIn: (smalltalk askFile: 'file name?').
  99. |
  100.     saveImage
  101.         smalltalk saveImage: (smalltalk askNewFile: 'image file?').
  102. ]
  103. Methods Method 'all'
  104.     showBytes    | aString |
  105.         aString <- ''.
  106.         bytecodes do: [:x | aString <- aString, (x printString, ' ', (x quo: 16),
  107.          ' ', (x rem: 16), '') ].
  108.         <185 1 aString>.
  109. ]
  110. Methods Class 'all'
  111.     addMethod    | m |
  112.         m <- Method new; text: ''.
  113.         (self doEdit: m)
  114.             ifTrue: [ methods at: m name put: m ]
  115. |
  116.     doEdit: method
  117.         " edit a method until it compiles correctly "
  118.         [ method text: method text edit.
  119.           (method compileWithClass: self)
  120.             ifTrue: [ ^ true ]
  121.             ifFalse: [ smalltalk inquire: 'edit again?' ]
  122.                 ] whileTrue.
  123.         ^ false
  124. |
  125.     display
  126.         ('Class name: ', name asString)  print.
  127.         (superClass notNil)
  128.             ifTrue: [ ('Superclass: ', superClass ) print ].
  129.         'Instance Variables:' print.
  130.         variables isNil
  131.             ifTrue: [ 'no instance variables ' print ]
  132.             ifFalse: [ variables display ].
  133.         'Subclasses: ' print.
  134.         self subClasses display
  135. |
  136.     editMethod: name    | m |
  137.         m <- self methodNamed: name.
  138.         (m notNil)
  139.             ifTrue: [ self doEdit: m ]
  140.             ifFalse: [ superClass notNil
  141.                     ifTrue: [ superClass editMethod: name ]
  142.                     ifFalse: [ 'no such method' print ] ]
  143. |
  144.     readInstanceVariables
  145.         self variables:
  146.             ((smalltalk getPrompt: 'Instance Variables? ')
  147.             words: [:x | x isAlphabetic ])
  148. |
  149.     readMethods
  150.         [ smalltalk inquire: 'Add a method?' ]
  151.             whileTrue: [ self addMethod ]
  152. |
  153.     viewMethod: methodName    | m |
  154.         m <- self methodNamed: methodName.
  155.         (m notNil) 
  156.             ifTrue: [ m signature print.  m text print ]
  157.             ifFalse: [ 'no such method' print ]
  158. ]
  159. Methods Smalltalk 'all'
  160.     getPrompt: aString
  161.         ^ <204 aString ''>
  162. |
  163.     inquire: aString
  164.         ^ <202 aString>
  165. |
  166.     askFile: aString
  167.         ^ <203 aString>
  168. |
  169.     askNewFile: aString
  170.         ^ <204 aString ''>
  171. |
  172.     echo
  173.         " enable - disable echo input "
  174.         echoInput <- echoInput not
  175. |
  176.     bytes
  177.         byteShow <- byteShow not
  178. |
  179.     print: aString
  180.         <200 aString>
  181. ]
  182. Methods String 'all'
  183.     edit    | file text |
  184.         file <- File new; 
  185.             scratchFile;
  186.             open: 'w';
  187.             print: self;
  188.             close.
  189.         ('memacs ', file name, ' OPT W') dosCommand.
  190.         "OPT W only works with memacs, so original below is commented"
  191.         "(editor, ' ', file name) dosCommand."
  192.         file open: 'r'.
  193.         text <- file asString.
  194.         file close; delete.
  195.         ^ text
  196. |
  197.     print
  198.         smalltalk print: self
  199. ]
  200. *
  201. * initialization code
  202. * this is executed once, by the initial image maker
  203. *
  204. *
  205. Methods Smalltalk 'doit'
  206.     error: aString
  207.         " print a message, and remove current process "
  208.         <201 aString>.
  209.         scheduler currentProcess; trace; terminate.
  210. ]
  211. Methods Scheduler 'get commands'
  212.     initialize
  213.         browserWindow <- BrowserWindow new.
  214.         eventManager <- EventManager new.
  215.         scheduler addProcess: eventManager.
  216. |
  217.     quit
  218.         " all done - really quit "
  219.         " should probably verify first "
  220.         notdone <- false
  221. |
  222.     processCount
  223.         ^ processList size
  224. ]
  225. Methods UndefinedObject 'initial image'
  226.     createGlobals    | aBlock |
  227.         " create global variables in initial image "
  228.         true <- True new.
  229.         false <- False new.
  230.         smalltalk <- Smalltalk new.
  231.         files <- Array new: 15.
  232.         stdin <- File new; name: 'stdin'; mode: 'r'; open.
  233.         stdout <- File new; name: 'stdout'; mode: 'w'; open.
  234.         stderr <- File new; name: 'stderr'; mode: 'w'; open.
  235.         editor <- 'memacs'.
  236.         " create a dictionary of classes "
  237.         classes <- Dictionary new.
  238.         symbols binaryDo: [:x :y | 
  239.             (y class == Class)
  240.                 ifTrue: [ classes at: x put: y ] ].
  241.         scheduler <- Scheduler new.
  242. |
  243.     initialize
  244.         " initialize the initial object image "
  245.         self createGlobals.
  246.         " create the initial system process "
  247.         " note the delayed recursive call "
  248.         aBlock <- [ files do: [:f | f notNil ifTrue: [ f open ]].
  249.                    systemProcess <- aBlock newProcess.
  250.                    echoInput <- false.
  251.                    byteShow <- false.
  252.                    scheduler run ].
  253.         systemProcess <- aBlock newProcess.
  254.         File new;
  255.             name: 'systemImage';
  256.             open: 'w';
  257.             saveImage;
  258.             close.
  259. ]
  260.